module Main where

import Data.Bits
import Network.Socket
import Network.BSD
import Data.List
import System.IO
import System.Time
import System.Locale
import Data.List
import Control.Concurrent


defaultPort = 6667

data ThreadState = Running | Interrupt | Terminated

data SyslogHandle = 
    SyslogHandle {slHandle :: Handle,
                  slProgram :: String}

openlog :: HostName             -- ^ Remote hostname, or localhost
        -> String               -- ^ Port number or name; 514 is default
        -> IO SyslogHandle      -- ^ Handle to use for logging
openlog hostname port =
		withSocketsDo $ do -- Look up the hostname and port.  Either raises an exception
       -- or returns a nonempty list.  First element in that list
       -- is supposed to be the best option.
       addrinfos <- getAddrInfo Nothing (Just hostname) (Just port)
       let serveraddr = head addrinfos

       -- Establish a socket for communication
       sock <- socket (addrFamily serveraddr) Stream defaultProtocol

       -- Mark the socket for keep-alive handling since it may be idle
       -- for long periods of time
       setSocketOption sock KeepAlive 1

       -- Connect to server
       connect sock (addrAddress serveraddr)
		-- Make a Handle out of it for convenience
       h <- socketToHandle sock ReadWriteMode
	   -- We're going to set buffering to BlockBuffering and then
       -- explicitly call hFlush after each message, below, so that
       -- messages get logged immediately
       hSetBuffering h (BlockBuffering Nothing)
       
       -- Save off the socket, program name, and server address in a handle
       return $ SyslogHandle h "IRC"
	   
mySend :: SyslogHandle -> String -> IO ()
mySend syslog msg =
		do 
		hPutStr (slHandle syslog) (msg++"\r\n")
		-- Make sure that we send data immediately
		hFlush (slHandle syslog)

myRecv :: SyslogHandle -> IO()
myRecv syslog = do
	str <- hGetLine (slHandle syslog)
	putStrLn str
	
closelog :: SyslogHandle -> IO ()
closelog syslogh = hClose (slHandle syslogh)

sendIdent sl nick= 
	do 	mySend sl $ "NICK "++nick
		mySend sl $ "USER "++nick++" 0 * :..."
		pong
		mySend sl $ "USERHOST "++nick
		where 
			pong = 
				do
					str <- hGetLine (slHandle sl)
					putStrLn str
					(a, b) <- return $ ping str
					case a of
						True -> mySend sl b
						False -> pong
			ping (a:b:c:d:xs) = if (a:b:c:d:[])=="PING" then (True, "PONG"++xs) else (False, xs)
			ping xs = (False, xs)
			
ircClose sl = 
	do 	mySend sl "QUIT :"
		closelog sl
		putStrLn "IRC closed"
		
ircConnect server port nick channel =
	do	syslog <- openlog server port
		mySend syslog "CAP LS"
		sendIdent syslog nick
		mySend syslog $ "JOIN #"++channel
		mySend syslog $ "MODE #"++channel
		hSetNewlineMode (slHandle syslog) (NewlineMode { inputNL  = CRLF, outputNL = CRLF })
		return syslog
		
runIrcService :: SyslogHandle -> String -> String -> Bool -> String -> MVar ThreadState->IO()
runIrcService sl nick channel listen bot state = 
	do	
		recv <- hGetLine (slHandle sl)
		var <- readMVar state
		case var of
			Interrupt -> do	
							ircClose sl
							suc <- tryPutMVar state Terminated
							putStrLn "interrupt received"
			Terminated -> putStrLn "Terminated"
			Running -> case isInfixOf "PING" recv of
				True -> answerPing recv
				False ->do
					(user, rest) <- return $ getUser recv
					(op, oprest) <- return $ checkOp rest
					case op of
						"JOIN" -> notify user
						"KICK" -> checkKick $ drop 1 oprest
						_ -> case user == nick of
											True -> compareMaster $ drop 1 $ dropWhile (\x->x/=':') oprest
											False -> compareUser user $ drop 1 $ dropWhile (\x->x/=':') oprest
		where
			continue = runIrcService sl nick channel listen bot state
			getUser xs = break (\x->x=='!') $ drop 1 xs 
			checkOp xs = break (\x->x==' ') $ drop 1 $ dropWhile (\x->x/=' ') xs
			answerPing xs = 
				case isPrefixOf "PING" xs of
					True -> do
						mySend sl $ "PONG"++ drop 4 xs
						continue
					False -> do
						mySend sl $ "NOTICE "++(takeWhile(\x->x/='!') $ drop 1 xs)++" "++ dropWhile(\x->x/=':') (drop 1 xs)
						continue
			notify user = do
				case user == nick of
					True -> do
								mySend sl $ "MODE #"++channel++" +o "++nick
								sendPriv $ "Welcome Master "++nick++" it's a great honor for me to serve you"
								continue
					False -> case listen of
							False -> do
										sendPriv $ "Hello "++user++", "++nick++" is currently not available I'll go and notify him of your presence" 
										continue
							True -> continue
			whois = do
				sendPriv $ nick++" is the most wonderful person in this world"
				continue
			awesome user = do
				sendPriv $ "I know that for sure but I am rubbish compared to my Master, "++nick
				continue
			kick user = do
				sendPriv "NO ONE CALLS ME SON OF A BITCH, SON OF A BITCH"
				mySend sl $ "KICK #"++channel++" "++user++" :DON'T CALL ME BITCH!"
				continue
			compareMaster input
				|sonofabitch input = do
								putStrLn input
								kick nick
								continue
				|input == "TURNOFF" = do
								sendPriv $ "Your wish is my command, Master "++nick++" I'll turn off"
								mySend sl "QUIT :IRC-Bot Created by Heimdall"
								ircClose sl
								res <- tryPutMVar state Terminated
								putStrLn "Quit command received"
				|input == "SHUTUP" = do
								sendPriv $ "Your wish is my command, Master "++nick++" I'll be quiet"
								runIrcService sl nick channel True bot state
				|input == "DOYOURJOB" = do
								sendPriv $ "I'll cover you while your absence Master "++nick
								runIrcService sl nick channel False bot state
				|input == "TIME" = sendTime nick
				|turnoffBoth input = do
								sendPriv $ "OK Master "++nick++" I'll close your services"
								mySend sl $ "KICK #"++channel++" "++nick++" :My Master "++nick++" says good bye, have a nice time"
								mySend sl "QUIT :IRC-Bot Created by Heimdall"
								ircClose sl
								putStrLn "Quit command received"
				|helloMsg input = do
								sendPriv $ "Hello Master "++nick
								continue
				|isInfixOf "IS A BITCH!" input = kickPlayer input
				|isSuffixOf " stinkt" input = do
								sendPriv $ "Master "++nick++" said "++(fst $ break(\x->x==' ')input)++" stinkt"
								mySend sl $ "KICK #"++channel++" "++(fst $ break(\x->x==' ')input)++" :"++(fst $ break(\x->x==' ')input)++" stinkt!"
								continue
				|isYoho input = yoho
				|otherwise = do
								putStrLn $ nick++":\t"++input
								continue
			compareUser user input
				|whoisstr input = 
							do	putStrLn $ user++":\t"++input
								whois
				|awesomestr input = 
							do	putStrLn $ user++":\t"++input
								awesome user
								
				|sonofabitch input = 
							do	putStrLn $ user++":\t"++input
								kick user
				|helloMsg input = do
								sendPriv $ "Hello "++user++", slave of Master "++nick
								continue
				|input == "TIME" = sendTime user
				|isYoho input = yoho
				|otherwise = do
								putStrLn $ user++":\t"++input
								case listen of 
									False -> case isInfixOf nick input of
											True -> do
												sendPriv $ "Master "++nick++" is not available atm he'll be back soon"
												continue
											False -> continue
									True -> continue
			whoisstr input = if input == "WHO IS " ++ nick then True else False
			awesomestr input = if input == "you are awesome "++bot then True else False
			sonofabitch input = if input == "you son of a bitch "++bot || input == "you son of a bitch "++nick then True else False
			sendPriv msg = mySend sl $ "PRIVMSG #"++channel++" :"++msg
			kickPlayer input = do
					sendPriv $ "Master "++nick++" told me you were a bitch! what a pity! I love my master and my master doesn't love you! I think I'll gonna kick you"
					mySend sl $ "KICK #"++channel++" "++(getUserToKick input)++" :Not loved by master"
					continue
			getUserToKick input = unwords $ helper $ words input where
						helper (x:xs) = if x /= "IS" then x:helper xs else []
			turnoffBoth input = if input == "TURN ME OFF" then True else False
			helloMsg input = if isInfixOf ("Hello "++bot) input || isInfixOf ("hello "++bot)input then True else False
			sendTime user = do
						time <- getClockTime
						cal <- toCalendarTime time
						sendPriv $ formatCalendarTime defaultTimeLocale "%a %b %d %T CEST" cal
						continue
			yoho  = do
					sendPriv "Drink up me 'earties. Yo ho"
					continue
			isYoho input = isInfixOf "yoho" input
			checkKick oprest
				|(head $ tail $ words oprest) == bot = do
						putStrLn oprest
						mySend sl $ "JOIN "++(head $ words oprest)
						continue
				|otherwise = do 
								putStrLn oprest
								continue
					
startIrcBot server port nick channel listen botAlias = do
		m <- newEmptyMVar
		--v <- takeMVar m
		tryPutMVar m Running
		handle <- ircConnect server port botAlias channel
		thread <- forkIO(runIrcService handle nick channel listen botAlias m)
		userInput handle nick channel botAlias m

userInput handle nick channel botAlias state = do
		var <- readMVar state
		case var of
			Terminated -> putStrLn "service terminated"
			Interrupt -> putStrLn "service interrupted"
			Running -> do
				line <- getLine
				checkInput line
	where
		sendMsg msg = mySend handle $ "PRIVMSG #"++channel++" :"++msg
		continue = userInput handle nick channel botAlias state
		checkInput input
			|input == "/QUIT" = quit
			|isPrefixOf "/KICK " input = kick input
			|isPrefixOf "/me" input = sendOpMsg "ACTION" $ dropWhile(\x->x==' ') $ drop 3 input
			|otherwise = do
				sendMsg input
				continue
		kick user = do
			mySend handle $ "KICK #"++channel++" "++(takeWhile (\x->x/=' ') $ drop 1 $ dropWhile(\x->x/=' ')user)++" :"++(takeWhile(\x->x/=')') $ drop 1 $ dropWhile (\x->x/='(')user)
			continue
		quit = do
			mySend handle $ "QUIT :"++botAlias++" says good bye"
			res <- tryPutMVar state Interrupt
			putStrLn "Input disabled"
		sendOpMsg code msg = do
			sendMsg $ "\001"++code++" "++msg++"\001"
			continue
		
main :: IO()
main = do
		putStrLn "Enter a Server"
		server <- getLine
		putStrLn "Enter your nick"
		nick <- getLine
		putStrLn "Enter a channel to connect"
		channel <- getLine
		putStrLn "Enter a bot alias"
		alias <- getLine
		putStrLn "ok connecting to the server"
		startIrcBot server "6667" nick channel True alias
		putStrLn "END"
		